(in-package #:org.shirakumo.fraf.trial.particle-studio)

(define-shader-pass ui (trial-alloy:base-ui)
  ())

(defmethod setup-ui ((ui ui))
  (setf *emitter-counter* 0)
  (clear (trial-alloy:show-panel 'base-panel)))

(defclass base-panel (trial-alloy:fullscreen-panel)
  ((sections :accessor sections)
   (file :initarg :file :initform NIL :accessor file)))

(defmethod initialize-instance :after ((panel base-panel) &key)
  (let* ((focus (make-instance 'alloy:focus-list))
         (layout (make-instance 'alloy:border-layout))
         (menu (alloy:with-menu
                 ("File"
                  ("New"
                   (clear panel)
                   (setf (file panel) NIL))
                  ("Load..."
                   (load-system :prompt panel))
                  :separator
                  ("Save"
                   (save-system T panel))
                  ("Save As..."
                   (save-system :prompt panel))
                  :separator
                  ("Quit"
                   (quit *context*)))
                 ("Edit"
                  ("Add Emitter"
                   (make-instance 'emitter))))))
    (setf (sections panel) (make-instance 'alloy:section-list :focus-parent focus))
    (let* ((toolbar (make-instance 'alloy:horizontal-linear-layout))
           (scroll (make-instance 'alloy:clip-view :inner (sections panel)))
           (side (make-instance 'alloy:sidebar :focus-parent focus :layout scroll)))
      (let* ((pause "Pause")
             (button (alloy:represent pause 'alloy:button :focus-parent focus :layout-parent toolbar)))
        (alloy:on alloy:activate (button)
          (setf (alloy:value button)
                (if (setf (paused-p panel) (not (paused-p panel)))
                    "Play" "Pause"))))
      (make-instance 'alloy:button* :value "Burst" :focus-parent focus :layout-parent toolbar :on-activate
                     (lambda () (emit panel T)))
      (alloy:enter toolbar side :place :north :size (alloy:un 30))
      (alloy:enter side layout :place :west :size (alloy:un 350)))
    (alloy:enter menu layout :place :north :size (alloy:un 30))
    (alloy:enter menu focus)
    (alloy:finish-structure panel layout focus)))

(defmethod serialize ((panel base-panel))
  (let ((data ()))
    (do-scene-graph (thing (scene +main+) (nreverse data))
      (when (typep thing 'emitter)
        (push (serialize thing) data)))))

(defmethod clear ((panel base-panel))
  (do-scene-graph (thing (scene +main+))
    (when (typep thing 'emitter)
      (leave thing T)))
  (make-instance 'emitter))

(defmethod load-system ((source stream) (panel base-panel))
  (let ((*package* #.*package*))
    (clear panel)
    (loop for f = (read source NIL #1='#:eof)
          until (eq f #1#)
          do (destructuring-bind (fun . args) f
               (ecase fun
                 (make-instance
                  (unless (equal ''cpu-particle-emitter (car args))
                    (error "Unknown source expression ~s" (car args)))
                  (apply #'make-instance 'emitter
                         (loop for arg in (rest args)
                               collect (eval arg)))))))))

(defmethod load-system ((path pathname) (panel base-panel))
  (with-open-file (stream path :direction :input)
    (load-system stream panel)
    (setf (file panel) path)))

(defmethod load-system ((path string) (panel base-panel))
  (load-system (pathname-utils:parse-native-namestring path) panel))

(defmethod load-system ((prompt (eql :prompt)) (panel base-panel))
  (let ((file (org.shirakumo.file-select:existing :title "Particle Studio"
                                                  :default (file panel)
                                                  :filter "sexp")))
    (when file
      (load-system file panel))))

(defmethod load-system ((default (eql T)) (panel base-panel))
  (load-system (or (file panel) :prompt) panel))

(defmethod save-system ((target stream) (panel base-panel))
  (format target "~&;;; Generated by trial-particle-studio")
  (let ((*print-case* :downcase)
        (*package* #.*package*))
    (do-scene-graph (thing (scene +main+))
      (when (typep thing 'emitter)
        (format target "~%(make-instance 'cpu-particle-emitter~{~%  ~s ~s~})~%"
                (serialize thing))))))

(defmethod save-system ((path pathname) (panel base-panel))
  (with-open-file (stream path :direction :output :if-exists :supersede)
    (save-system stream panel)
    (setf (file panel) path)))

(defmethod save-system ((path string) (panel base-panel))
  (save-system (pathname-utils:parse-native-namestring path) panel))

(defmethod save-system ((prompt (eql :prompt)) (panel base-panel))
  (let ((file (org.shirakumo.file-select:new :title "Particle Studio"
                                             :default (file panel)
                                             :filter "sexp")))
    (when file
      (save-system file panel))))

(defmethod save-system ((default (eql T)) (panel base-panel))
  (save-system (or (file panel) :prompt) panel))

(defmethod paused-p ((panel base-panel))
  (do-scene-graph (thing (scene +main+))
    (when (typep thing 'emitter)
      (return (paused-p thing)))))

(defmethod (setf paused-p) (value (panel base-panel))
  (do-scene-graph (thing (scene +main+) value)
    (when (typep thing 'emitter)
      (setf (paused-p thing) value))))

(defmethod emit ((panel base-panel) count &rest args)
  (do-scene-graph (thing (scene +main+))
    (when (typep thing 'emitter)
      (apply #'emit thing count args))))
